home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / TRAPS < prev    next >
Encoding:
Text File  |  1992-01-25  |  4.7 KB  |  202 lines
  1. \ Trap 68000 Exceptions
  2. \
  3. \ Copyright 1986
  4. \ MOD: PLB 9/4/88 Use AUTO.INIT
  5. \ MOD: PLB 9/9/88 Use IF.FORGOTTEN
  6. \ MOD: mdh 12/28/88 Incorporate 68010, 68012 and 68020 CPUs, add extra info
  7. \
  8. \ 00001 14-may-90 mdh LoadJForth files now in jf:
  9. \ 00002 15-aug-91 mdh remove dependancy on modules
  10. \ 00003 16-aug-91 plb SAVE-FORTH redef not needed, see JF:AUTO
  11. \ 00004 25-jan-92 mdh turned CR to >NEWLINE
  12.  
  13. decimal
  14.  
  15. \ .need eb_AttnFlags    00002
  16. \   getmodule includes
  17. \ .then
  18.  
  19. ONLY FORTH DEFINITIONS 
  20. DECIMAL
  21.  
  22. include? comp jf:@bits  \ 00001
  23.  
  24. : Is68000?  ( -- flag , true if ol' faithful! )
  25.   exec_lib @ >rel  296 + w@  \ CAN'T CHANGE ---->>>> ..@ eb_AttnFlags 00002
  26.   [ ( AFF_68010 ) 1    ( AFF_68020 ) 2   or
  27.     ( AFF_68030 ) 4 or ( AFF_68040 ) 8   or ] literal  and  0=
  28. ;
  29.  
  30. : GET-TCB  ( --- adr )  0 CALL EXEC_LIB FINDTASK  >rel  ;
  31.  
  32. : GET-TRAP   ( trap=number --- flag ) CALL EXEC_LIB ALLOCTRAP  ;
  33. : FREE-TRAP  ( TRAP-NUMBER --- FLAG ) CALL EXEC_LIB FREETRAP  ;
  34.  
  35. : NO-EMULATION   ." A or F line instruction"  ;
  36. DEFER 1010-EMULATE
  37. ' no-emulation is 1010-emulate
  38. DEFER 1111-EMULATE
  39. ' no-emulation is 1111-emulate
  40.  
  41. DEFER DO-TRACE 
  42. : <DO-TRACE>  ( ---- )  ( 680xx-stack-frame raddr --r-- ) rdrop 
  43.     ." trace "  rte ; 
  44. ' <DO-TRACE> IS DO-TRACE
  45.  
  46. .need AND-TO-SR
  47. : AND-TO-SR  [  $ 40c0,c087 ,  $ 2e1e,46c0 ,  ]  both ;
  48. .then
  49.  
  50. max-inline @   20 max-inline !
  51. : <USER-QUIT> ( --- ) 
  52.   [ 0 DECIMAL 13 SET-BIT COMP ] LITERAL AND-TO-SR
  53.   r> drop
  54. \ $ 2000 0 call exec_lib setsr  drop  
  55.   ' (quit) >abs >r  ;
  56. max-inline !
  57.  
  58. : .Ret  ( addr amt-to-add -- )
  59.   ."  at $" swap 2+ @ + >rel  .hex
  60. ;
  61.  
  62. DECIMAL
  63.  
  64. : AdrErrSize  ( -- #bytes )
  65.   [  9 2* ] literal   \ 68000 size is 7 words + 2 for retadr
  66.   Is68000? 0= IF
  67.      [ 22 2* ] literal  +   \ other cpus stack 22 more words
  68.   THEN
  69. ;
  70.  
  71. : TrapFrameSize  ( -- #bytes )
  72.   [ 5 2* ] literal   \ 68000 size is 3 words + 2 for retadr
  73.   Is68000? 0= IF
  74.      \
  75.      ( -r- ?? fmt/vec16 pc/lo/16 pc/hi/16 statreg/16 ret/lo/16 ret/hi/16 )
  76.      ( -r- ??        cell2             cell1                cell0        )
  77.      \
  78.      2 rpick   $ f000,0000 and  $ 8000,0000 =  IF
  79.         [ 26 2* ] literal  +   \ other cpus stack 26 more words
  80.      THEN
  81.   THEN
  82. ;
  83.  
  84. \ 18 CONSTANT AdrErrSize68k
  85. \ AdrErrSize68k 22 2* ( words ) + constant AdrErrSize68k+
  86. \ 10 CONSTANT TRAP-FRAME-SIZE
  87.  
  88. : <trap>  ( --- )  ( 680xx-stack-frame exception# --R-- ??? ) SAVE-CPU
  89.   R> CR DUP  decimal ." TRAP " .  ." : "
  90.   CASE
  91.     3  OF ." Address error, instruction at $"  
  92.           rp@ 6 + w@  ( -- inst )
  93.           rp@ $ 0a + @ >rel  ( -- inst pc )
  94.           BEGIN
  95.              2- 2dup w@ =
  96.           UNTIL
  97.           nip  .hex   ." accessing $"
  98.           rp@ 2+ @ >rel .hex
  99.           AdrErrSize  RP+!  <USER-QUIT>     ENDOF
  100.     4  OF ." ILLEGAL instruction" rp@ 0 .Ret   ENDOF
  101.     5  OF ." Divide by zero by instruction" rp@ -2 .Ret ENDOF
  102.     6  OF ." CHK instruction" rp@ -4 .Ret ENDOF
  103.     7  OF ." TRAPV instruction" rp@ -2 .Ret ENDOF 
  104.     8  OF ." Privilege violation" rp@ 0 .Ret ENDOF
  105.     9  OF DO-TRACE  ENDOF
  106.     10 OF 1010-EMULATE rp@ 0 .Ret ENDOF
  107.     11 OF 1111-EMULATE rp@ 0 .Ret ENDOF 
  108.            ." unrecognized EXCEPTION trap" . CR  RTE
  109.   ENDCASE
  110.   TrapFrameSize RP+! <USER-QUIT>    ; 
  111.  
  112. .NEED +field
  113. : +FIELD  ( OFFSET SIZE --- FOFSET+SIZE ) CREATE OVER , + 
  114.       DOES>  ( ADR <BODY> --- ADR+ )   @ +  ;
  115. .THEN
  116.  
  117. .NEED +NODE-SIZE
  118. 0
  119. 4 +field suc
  120. 4 +field pre
  121. 1 +field typ
  122. 1 +field pri
  123. 4 +field nam
  124. 0 +field +node-size 
  125. drop
  126.  
  127. 0 
  128. +node-size 
  129. 1 +field +FLAGS 
  130. 1 +field +STATE
  131. 1 +field +IDNestCnt
  132. 1 +field +TDNestCnt
  133.  
  134. 4 +field +SigAlloc
  135. 4 +field +SigWait
  136. 4 +field +SigRecvd
  137. 4 +field +SigExcept
  138.  
  139. 2 +field +TrapAlloc
  140. 2 +field +TrapAble
  141.  
  142. 4 +field +ExceptData
  143. 4 +field +ExcpetCode
  144. 4 +field +TrapData
  145. 4 +field +TrapCode
  146. constant rest
  147. .THEN
  148.  
  149. variable was_trapcode
  150.  
  151. DECIMAL
  152. : TRAPS   ( -- ) >newline
  153.   get-tcb +trapcode @  ' <trap> >abs  = not
  154.   IF  get-tcb +trapcode @ was_trapcode !
  155.       5 GET-TRAP 0<  ?ABORT" TRAP TAKEN"
  156.       ' <trap> >abs get-tcb +trapcode ! 
  157.          ." TRAPS installed."
  158.   ELSE   ." TRAPS already installed."
  159.   THEN cr
  160. ;
  161.  
  162. : NOTRAPS  ( -- )
  163.   get-tcb +trapcode @  ' <trap> >abs =
  164.   IF   was_trapcode @  get-tcb +trapcode !
  165.        5 free-trap  drop
  166.   ELSE >newline ( 00004 )  ." TRAPS not installed." cr
  167.   THEN ;
  168.  
  169.  
  170. FALSE .IF 
  171. DECIMAL
  172. : REAL  ( --- )   11 3 
  173.    DO  I GET-TRAP 0< 
  174.        IF  I . "  TRAP TAKEN" CR 
  175.        THEN
  176.    LOOP     ' say >abs get-tcb +trapcode !  ; 
  177. .THEN
  178.  
  179. \ 00003
  180. \ : SAVE-FORTH   ( -- , remove traps before saving image )
  181. \   get-tcb +trapcode @  ' <trap> >abs =
  182. \   IF   NOTRAPS true
  183. \   ELSE false
  184. \   THEN save-forth
  185. \   IF   TRAPS
  186. \   THEN ;
  187.  
  188. \ Try using AUTO.INIT for turning on traps.
  189. EXISTS? AUTO.INIT .IF
  190. : AUTO.INIT
  191.     traps
  192.     auto.init
  193. ;
  194. : AUTO.TERM
  195.     auto.term
  196.     notraps
  197. ;
  198. .THEN
  199.  
  200. \ Turn off traps if this code is forgotten.
  201. IF.FORGOTTEN NOTRAPS
  202.